home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / README.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  4KB  |  140 lines
  1. Program README;
  2.  
  3. {$M 15000,0,655000}
  4.  
  5. uses PbCRT, PbMISC, PbDATA, PbOBJS, PbHIGH, PbPARMS, PbOUT0,
  6.      PbSELECT, PbHELP;
  7.  
  8. {
  9. Description:  README - Simple Program to View text files
  10.  
  11. Author      : Howard Richoux
  12. Date        : 1/9/91
  13. Last revised: 1/11/94 1.00 cleanup
  14.               5/2/94  1.06 re-write add cfg file & print
  15. Application : IBM PC and compatibles, done in Turbo Pascal 5.0
  16. Status      : Placed in the Public Domain by HNR Software 1/29/94
  17. Published in: none
  18. }
  19.  
  20.  
  21. var dir,template   : string[40];
  22. var x              : CRTSaveRec;
  23.  
  24.  
  25. Function OKToRead(fn : string) : boolean;
  26. var ok   : boolean;
  27.     extn : string[4];
  28.     i    : integer;
  29.     s    : string[1];
  30.     crtsave : crtsaverec;
  31.      begin
  32.      ok := true;
  33.      extn := rightstr(fn,4);
  34.      if (extn = '.EXE') or (extn = '.COM') or
  35.         (extn = '.DBF') or (extn = '.ZIP') or
  36.         (extn = '.TPU') or (extn = '.   ') or
  37.         (extn = '.ARC') or (extn = '.PCK') or
  38.         (extn = '.OBJ') then
  39.           begin
  40.           ok := false;
  41.           SimpleWindow(10,10,3,60,' NOT A TEXT FILE ',' Select again. ',crtsave);
  42.           writeln('');
  43.           writeln('  ',fn);
  44.           readln(s);
  45.           RestoreCRT(crtsave);
  46.           end;
  47.      OKToRead := ok;
  48.      end;
  49.  
  50.  
  51. Procedure OUTTextFile(fn : string);  {Probably move this to PbOUTs if useful }
  52. var tx : TFILE_object;
  53.     s : string;
  54.     begin
  55.     tx.init(fn,false);
  56.     while tx.fetchnext(s) do
  57.          begin
  58.          OUT(s);
  59.          end;
  60.     OUTdoneWithPage;
  61.     end;
  62.  
  63.  
  64. Procedure DoView(dir,template : string);
  65. var filename   : string[40];
  66.     cmd        : string[40];
  67.     itemselect : integer;
  68. var files      : STRA_object;
  69.      begin
  70.      itemselect := 1;
  71.      HelpMaxLines := 1000;
  72.      filename   := '';
  73.      cmd        := '?RESELECT';
  74.      files.init(200);
  75.      GetfilesSTRA(dir+Template, files, fsortbyname);
  76.      while itemselect > 0 do
  77.           begin
  78.           SetSelectwindow(3,3,15,3,15);
  79.           SetSelectWindowLabels(' '+pProgID+' - Text File Viewer ',
  80.                                 ' Select a File w/Arrows - ESC to exit ');
  81.           Select(files,filename,itemselect,cmd);
  82.           if (filename <> '') and OKToRead(filename) then
  83.               begin
  84.               DoHelpW(dir+filename,'','',1,1,22,77,cmd); {this is the biggest}
  85.               if cmd = '?SCREENPR' then OUTTextFile(dir+filename);
  86.               end;
  87.           end;
  88.      files.done;
  89.      end;
  90.  
  91.  
  92. Procedure READMEInit;
  93. var i : integer;
  94.     s : string;
  95.      begin
  96.      if paramcount > 0 then
  97.           begin
  98.           s := UpCaseStr(paramstr(1));
  99.           if      (s = 'A') or ( s = 'A:') then dir := 'A:'
  100.           else if (s = 'B') or ( s = 'B:') then dir := 'B:'
  101.           else if s[length(s)] = '\'       then dir := s
  102.           else begin
  103.                i := pos('.',s);
  104.                if i > 0 then template := s
  105.                else dir := s;
  106.                end;
  107.           end;
  108.  
  109.      i := pos('\',template);
  110.      if i > 0 then dir := ExtractPath(template);
  111.      if dir = '' then getdir(0,dir);
  112.      dir := addbackslash(dir);
  113.      end;
  114.  
  115.  
  116. Procedure Init;
  117.      begin
  118.      AddParm(1,'DIR','');
  119.      ADDParm(1,'TEMPLATE','*.*');
  120.      AddParm(1,'OUT','LPT1');
  121.  
  122.      StandardOUTInit;
  123.  
  124.      dir      := GetParmStr('DIR');
  125.      template := GetParmStr('TEMPLATE');
  126.  
  127.      end;
  128.  
  129.  
  130.      begin {main}
  131.      pProgID := 'README 1.06';
  132.      Init;
  133.      SaveCRT(x);
  134.      READMEInit;
  135.      if template <> '' then DoView(dir,template)
  136.      else writeln('template = ',template,'   dir = ',dir);
  137.      RestoreCRT(x);
  138.      OutDone;
  139.      end.
  140.